home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 22 / Cream of the Crop 22.iso / program / eflibpt4.zip / DEMO / DATATYPE / LISTPERF.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-18  |  4KB  |  102 lines
  1. { Borland Pascal Extended Function Library - EFLIB (C) Johan Larsson, 1996
  2.   Demonstration; list performance test
  3.  
  4.   EFLIB IS PROTECTED BY THE COPYRIGHT LAW AND MAY NOT BE COPIED, SOLD OR
  5.   MANIPULATED. FOR MORE INFORMATION, SEE PROGRAM MANUAL! THIS DEMONSTRAT-
  6.   ION PROGRAM MAY FREELY BE USED AND DISTRIBUTED.                          }
  7.  
  8.  
  9. uses EFLIBDEF, EFLIBINI, EFLIBBAS, EFLIBDAT, CRT;
  10.  
  11.  
  12. const NumberOfElements = 5000;
  13.  
  14. var Data : array [1..6] of DataObjectPointerType;
  15.     Current : DataObjectPointerType; Timer : TimerObjectType;
  16.     Index : word; Number : real; MemoryUsage : longint;
  17.  
  18.  
  19. procedure TestElementAddition;
  20. begin
  21.      RandSeed := 0; { Control random seed }
  22.      Timer.Initialize;
  23.      for Index := 1 to NumberOfElements do begin
  24.          Number := Pi * (Succ(Random(100))/Succ(Random(100)));
  25.          Current^.Add (Number);
  26.      end;
  27.      Write (MemoryUsage - MemAvail:8);
  28.      Write (Timer.ElapsedMS:17:0);
  29.      Timer.Intercept;
  30. end;
  31.  
  32. procedure TestElementAccess;
  33. begin
  34.      Timer.Initialize;
  35.      for Index := 1 to NumberOfElements do
  36.          Current^.Element (Index, Number);
  37.      Write (Timer.ElapsedMS:25:0);
  38.      Timer.Intercept;
  39. end;
  40.  
  41. procedure Test;
  42. begin
  43.      TestElementAddition;
  44.      TestElementAccess;
  45. end;
  46.  
  47. begin
  48.      { This program will test the performance of different data types.
  49.        Not all data types are tested. The remaining data types are
  50.        descendants or close relatives to the tested data types.
  51.  
  52.        Each data type is tested in 1) element adding and 2) sequential
  53.        access. Each test is measured in duration and the results are
  54.        displayed. Also, the testing involve memory usage check. }
  55.  
  56.      WriteLn; TextBackground (Blue);
  57.      Write ('Datatype', '':12, 'Memory usage .... Element adding ...... Seq. access [ms] ');
  58.      TextBackground (Black); WriteLn;
  59.  
  60.      Write ('Array list          '); MemoryUsage := MemAvail;
  61.      Data[1] := New(ArrayListObjectPointerType, Initialize(NumberOfElements, SizeOf(Number)));
  62.      Current := Data[1]; Test; WriteLn;
  63.  
  64.      Write ('Virtual list        '); MemoryUsage := MemAvail;
  65.      Data[2] := New(VirtualListObjectPointerType, Initialize(0, Succ(NumberOfElements div 100), SizeOf(Number)));
  66.      Current := Data[2]; Test; WriteLn;
  67.  
  68.      Write ('Pointer list        '); MemoryUsage := MemAvail;
  69.      Data[3] := New(PointerListObjectPointerType, Initialize(NumberOfElements, SizeOf(Number)));
  70.      Current := Data[3]; Test; WriteLn;
  71.  
  72.      Write ('Linked list         '); MemoryUsage := MemAvail;
  73.      Data[4] := New(LinkedListObjectPointerType, InitializeList(SizeOf(Number), UnsortedOrder, TRUE, TRUE));
  74.      Current := Data[4]; Test; WriteLn;
  75.  
  76. (*   Write ('Cached linked list  '); MemoryUsage := MemAvail;
  77.      Data[5] := New(CachedLinkedListObjectPointerType, InitializeList(SizeOf(Number), NumberOfElements div 50,
  78.                  UnsortedOrder, FALSE, FALSE));
  79.      Current := Data[5]; Test; WriteLn; *)
  80.  
  81. (*   Write ('Segment linked list '); MemoryUsage := MemAvail;
  82.      Data[6] := New(SegmentLinkedListObjectPointerType, InitializeList(SizeOf(Number), NumberOfElements div 50,
  83.                  UnsortedOrder, FALSE, FALSE));
  84.      Current := Data[6]; Test; WriteLn; *)
  85.  
  86.      WriteLn ('Checking data type integrity ...');
  87.  
  88.      { Certify that all data structures contains exactly the same data. Uses
  89.        the IsEqual method that compares polymorphic data types. }
  90.      for Index := 1 to Pred(SizeOf(Data) div SizeOf(DataObjectPointerType)) do
  91.          if Data[Index]^.IsInitialized and Data[Succ(Index)]^.IsInitialized and
  92.             not Data[Index]^.IsEqual(Data[Succ(Index)]) then
  93.             WriteLn ('Data type ', Index, ' has errors.');
  94.  
  95.      WriteLn ('Done.');
  96.  
  97.      { Dispose all data structures }
  98.      for Index := 1 to SizeOf(Data) div SizeOf(DataObjectPointerType) do
  99.          if Data[Index]^.IsInitialized then Data[Index]^.Free;
  100.  
  101.      if GlobalDataError then WriteLn ('Error(s) reported!');
  102. end.